#library(termstrc)
library(YieldCurve)
library(NMOF)
library(np)
library(readxl)
library(sm)


# plot components
lambdaFunction<-function(lambda,tau=2.5){
 (1-exp(-tau*lambda))/(tau*lambda)-exp(-tau*lambda)
#  ((1-exp(-tau*lambda))/(2.5*lambda)-exp(-tau*lambda) - 0:0609)^2
}

optimize(lambdaFunction,maximum=TRUE,interval=c(1e-15,100))
#optim(lambdaFunction,interval=c(1e-15,100))


c2<-function(tau,beta1=param[2],lambda=param[4]){
  beta1*(1-exp(-tau*lambda))/(tau*lambda)
}

c3<-function(tau,beta1=param[2],beta2=param[3],lambda=param[4]){
  beta1*(1-exp(-tau*lambda))/(tau*lambda)+beta2*((1-exp(-tau*lambda))/(tau*lambda)-exp(-lambda*tau))
}



c4<-function(tauStar) param[1]+c2(tauStar)+c3(tauStar)

param<-c(5, -2, -8, 1.5)


par(mfrow=c(2,2))

plot(0:15,rep(param[1],16),type="l",
     xlab="Tau (time to maturity)",ylab="Bond yield rate (%)",
     main="Long-run yield level")

curve(c2,from=0,to=16,type="l",main="Short-end shift",
      xlab="Tau (time to maturity)",ylab="Bond yield rate (%)")

curve(c3,from=0,to=16,type="l",main="Medium-term trough",
      xlab="Tau (time to maturity)",ylab="Bond yield rate (%)")

curve(c4,from=0,to=16,type="l",main="Nelson-Siegel Yield Curve",
      xlab="Tau (time to maturity)",ylab="Bond yield rate (%)")

###
# toy data example
setwd("X:\\Access\\Gas\\DRP Methods")
# wb<-loadWorkbook("data\\GGT DRP annual update - ERA Revised Bond Yield Approach (29 June 2018)_TOY.xlsx")
# getSheets(wb)
# yieldData<-readWorksheet(wb,sheet="Gaussian Kernel",startRow=2)

yieldData<-read_excel("data\\GGT DRP annual update - ERA Revised Bond Yield Approach (29 June 2018)_TOY.xlsx",sheet="Gaussian Kernel",skip=1)


yieldData<-yieldData[-nrow(yieldData),c(2:3,7)]

names(yieldData)<-c("tenor","yield","faceValue")

yieldData$tenor<-as.numeric(yieldData$tenor)

yield50<-yieldData[yieldData$tenor < 50,]

yield15 <-yieldData[yieldData$tenor < 15,]

NSyc<-Nelson.Siegel(yieldData$yield,yieldData$tenor)
NSyc50<-Nelson.Siegel(yield50$yield,yield50$tenor)
NSyc15<-Nelson.Siegel(yield15$yield,yield15$tenor)

inTenor<-c(1/(5:2),seq(1,80,length=101))
inTenor50<-c(1/(5:2),seq(1,50,length=101))
inTenor15<-c(1/(5:2),seq(1,15,length=101))

NScurve<-function(tau,param) {
  c2<-function(x,beta1=param[2],lambda=param[4]){
    beta1*(1-exp(-x*lambda))/(x*lambda)
  }
  
  c3<-function(x,beta2=param[3],lambda=param[4]){
    beta2*((1-exp(-x*lambda))/(x*lambda)-exp(-lambda*x))
  }

   param[1]+c2(tau,beta1=param[2],lambda=param[4])+
      c3(tau,beta2=param[3],lambda=param[4])
}


plot(yieldData$tenor,yieldData$yield,
     main="Nelson-Siegal Estimator",
     xlab="Tenor (years)",ylab="Yield (AUD annualised %)",
     col="orange")
lines(inTenor,NScurve(inTenor,NSyc),col="orange")

points(yield50$tenor,yield50$yield,col="red")
lines(inTenor50,NScurve(inTenor50,NSyc50),col="red")

points(yield15$tenor,yield50$yield)
lines(inTenor15,NScurve(inTenor15,NSyc15))

abline(v=10,lty=2)

legend(20,y=4,legend=c("all data","data<50","data<15","tenor=10"),
       col=c("orange","red","black","black"),lty=c(1,1,1,2))

excelNS<-c(9.98469E-15,2.440994266,14.19345209,0.05467)
lines(inTenor,NScurve(inTenor,excelNS),col="purple",lwd=1)

parameterReport<-as.data.frame(rbind(NSyc,NSyc50,NSyc15,excelNS))
names(parameterReport)<-c("B0","B1","B2","lambda1")
parameterReport<-cbind(parameterReport,COD_NS=
                 c(NScurve(10,NSyc),NScurve(10,NSyc50),NScurve(10,NSyc15),
                   NScurve(10,excelNS)))
parameterReport<-round(parameterReport,4)


yieldGauss<-sm.regression(yieldData$tenor,yieldData$yield ,h=1.5,
              weights=yieldData$faceValue,display="none",
              eval.points=inTenor)
yieldGauss50<-sm.regression(yield50$tenor,yield50$yield ,h=1.5,
                          weights=yield50$faceValue,display="none",
                          eval.points=inTenor50)
yieldGauss15<-sm.regression(yield15$tenor,yield15$yield ,h=1.5,
                          weights=yield15$faceValue,display="none",
                          eval.points=inTenor15)

tauGauss_10<- dnorm(yieldData$tenor,mean=10,sd=1.5)
tauWeight_10<-tauGauss_10*yieldData$faceValue
tauWeight_10<-tauWeight_10/sum(tauWeight_10)*yieldData$tenor

tauGauss_7<- dnorm(yieldData$tenor,mean=7,sd=1.5)
tauWeight_7<-tauGauss_7*yieldData$faceValue#/sum(yieldData$faceValue)
tauWeight_7<-tauWeight_7/sum(tauWeight_7)*yieldData$tenor

#adjTenor<-10
adjTenor<- c(sum(tauWeight_7),sum(tauWeight_10))
  

yieldGauss_10<-sm.regression(yieldData$tenor,yieldData$yield ,h=1.5,
                          weights=yieldData$faceValue,display="none",
                          eval.points=adjTenor)
yieldGauss50_10<-sm.regression(yield50$tenor,yield50$yield ,h=1.5,
                            weights=yield50$faceValue,display="none",
                            eval.points=adjTenor)
yieldGauss15_10<-sm.regression(yield15$tenor,yield15$yield ,h=1.5,
                            weights=yield15$faceValue,display="none",
                            eval.points=adjTenor)

effectiveTenor<-rbind(yieldGauss_10$estimate,
  yieldGauss50_10$estimate,
  yieldGauss15_10$estimate
)

targetTenor<-10
targetTenorYield<-effectiveTenor[,1]+
  apply(effectiveTenor,1,diff)/diff(adjTenor)*(targetTenor-adjTenor[1])

parameterReport<-cbind(parameterReport, 
                       COD_Gauss =c(targetTenorYield,NA)
       )

round(parameterReport,4)



NSSyc<-Svensson(yieldData$yield,yieldData$tenor)
NSSyc50<-Svensson(yield50$yield,yield50$tenor)
NSSyc15<-Svensson(yield15$yield,yield15$tenor)



### DE method for NSS   -----------------------------------------------
NSScurve<-function(tau,param) {
  c2<-function(x,beta1=param[2],lambda1=param[4]){
    beta1*(1-exp(-x*lambda1))/(x*lambda1)
  }
  
  c3<-function(x,beta2=param[3],lambda1=param[4]){
    beta2*((1-exp(-x*lambda1))/(x*lambda1)-exp(-lambda1*x))
  }

  c4<-function(x,beta3=param[3],lambda2=param[4]){
    beta3*((1-exp(-x*lambda2))/(x*lambda2)-exp(-lambda2*x))
  }
  
  param[1]+c2(tau,beta1=param[2],lambda=param[4])+
    c3(tau,beta2=param[3],lambda1=param[4]) +
    c4(tau,beta3=param[5],lambda2=param[6])
}

betaTrue<-c(1,-0.5,1,1,1.6416,4.5834)
NSSdata <- list(yM = yieldData$yield,
             tm = yieldData$tenor,
             model = NSS,
             min = c( 0,-15,-30,-30, 0,2.5),
             max = c(15, 30, 30, 30, 2.5, 5),
             ww = 1)

penalty <- function(mP, data) {
  minV <- data$min
  maxV <- data$max
  ww <- data$ww
  ## if larger than maxV, element in A is positiv
  A <- mP - as.vector(maxV)
  A <- A + abs(A)
  ## if smaller than minV, element in B is positiv
  B <- as.vector(minV) - mP
  B <- B + abs(B)
  ## beta 1 + beta2 > 0
  C <- ww*((mP[1L, ] + mP[2L, ]) - abs(mP[1L, ] + mP[2L, ]))
  A <- ww * colSums(A + B) - C
  A
}

algo <- list(nP = 100L,
             nG = 500L,
             F = 0.50,
             CR = 0.99,
             min = c( 0,-15,-30,-30, 0,2.5),
             max = c(15, 30, 30, 30, 2.5, 5),
             pen = penalty,
             repair = NULL,
             loopOF = TRUE,
             loopPen = FALSE,
             loopRepair = TRUE,
             printBar = FALSE,
             printDetail = FALSE)

OF <- function(param,data) {
  y <- data$model(param,data$tm)
  aux <- (y - data$yM)^2
  res <- sum(abs(aux))
  # aux <- y - data$yM
  # res <- max(abs(aux))
  
  ## compute the penalty
  aux <- y - abs(y) ## aux == zero for nonnegative y
  aux <- -sum(aux) * data$ww
  res <- res + aux
  if (is.na(res)) res <- 1e10
  res
}

sol <- DEopt(OF = OF, algo = algo, data = NSSdata)
NSS(sol$xbest,10)


### DE method for NS   -----------------------------------------------
betaTrue<-c(1,-0.5,1,1.6416)
NSdata <- list(yM = yieldData$yield,
                tm = yieldData$tenor,
                model = NS,
                min = c( 0,-15,-30,0),
                max = c(15, 30, 30, 5),
                ww = 1)

penalty <- function(mP, data) {
  minV <- data$min
  maxV <- data$max
  ww <- data$ww
  ## if larger than maxV, element in A is positiv
  A <- mP - as.vector(maxV)
  A <- A + abs(A)
  ## if smaller than minV, element in B is positiv
  B <- as.vector(minV) - mP
  B <- B + abs(B)
  ## beta 1 + beta2 > 0
  C <- ww*((mP[1L, ] + mP[2L, ]) - abs(mP[1L, ] + mP[2L, ]))
  A <- ww * colSums(A + B) - C
  A
}

algoNS <- list(nP = 100L,
             nG = 500L,
             F = 0.50,
             CR = 0.99,
             min = c( 0,-15,-30, 0),
             max = c(15, 30, 30, 10),
             pen = penalty,
             repair = NULL,
             loopOF = TRUE,
             loopPen = FALSE,
             loopRepair = TRUE,
             printBar = FALSE,
             printDetail = FALSE)

OF <- function(param,data) {
  y <- data$model(param,data$tm)
  aux <- (y - data$yM)^2
  res <- sum(abs(aux))
  # aux <- y - data$yM
  # res <- max(abs(aux))
  
  ## compute the penalty
  aux <- y - abs(y) ## aux == zero for nonnegative y
  aux <- -sum(aux) * data$ww
  res <- res + aux
  if (is.na(res)) res <- 1e10
  res
}

solNS <- DEopt(OF = OF, algo = algoNS, data = NSdata)
NS(solNS$xbest,10)
sm.regression(yieldData$tenor,yieldData$yield ,h=1.5,
                          weights=yieldData$faceValue,display="none",
                          eval.points=10)$estimate



###

NSSdata50 <- list(yM = yield50$yield,
                tm = yield50$tenor,
                model = NSS,
                min = c( 0,-15,-30,-30, 0,2.5),
                max = c(15, 30, 30, 30, 2.5, 5),
                ww = 1)

sol50 <- DEopt(OF = OF, algo = algo, data = NSSdata50)

NSSdata15 <- list(yM = yield15$yield,
                  tm = yield15$tenor,
                  model = NSS,
                  min = c( 0,-15,-30,-30, 0,2.5),
                  max = c(15, 30, 30, 30, 2.5, 5),
                  ww = 1)

sol15 <- DEopt(OF = OF, algo = algo, data = NSSdata15)


#sum(abs(NSS(sol$xbest,inTenor)-NSS(sol50$xbest,inTenor)))


NSS(sol$xbest,inTenor)-NSS(sol50$xbest,inTenor)


plot(yieldData$tenor,yieldData$yield,
     main="Nelson-Siegal-Svensson Estimator",
     xlab="Tenor (years)",ylab="Yield (AUD annualised %)",
     col="orange")
lines(inTenor,NSS(sol$xbest,inTenor),col="orange")

lines(inTenor,)

points(yield50$tenor,yield50$yield,col="red")
lines(inTenor50,NSS(sol50$xbest,inTenor50),col="red")

points(yield15$tenor,yield15$yield)
lines(inTenor15,NSS(sol15$xbest,inTenor15))

abline(v=10,lty=2)

legend(20,y=4,legend=c("all data","data<50","data<15","excel all","tenor=10"),
       col=c("orange","red","black","purple","black"),lty=c(1,1,1,1,2))

excelNSS<-c(4.971,10.961,7.288,-21.556,0.42411,0.62521)
lines(inTenor,NSS(excelNSS,inTenor),col="purple")
excelNSS<-c(4.142,-0.522,-7.842,8.055,2.5,5)
lines(inTenor,NSS(excelNSS,inTenor),col="purple",lwd=2)



parameterReportNSS<-as.data.frame(rbind(alldata=sol$xbest,data50=sol50$xbest,data15=sol15$xbest,excel=excelNSS))
names(parameterReportNSS)<-c("B0","B1","B2","B3","lambda1","lambda2")
parameterReportNSS<-cbind(parameterReportNSS,COD_NSS=
                         c(NSS(sol$xbest,10),NSS(sol50$xbest,10),NSS(sol15$xbest,10),
                           NSS(excelNSS,10)))
round(parameterReportNSS,4)


library(Rblpapi)
head(bsrch("FI:Western Power QA 3 April 2018", verbose = TRUE),20)



